perm filename Z[XX,LCS]1 blob sn#206571 filedate 1976-03-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	***** COPYIT
C00009 ENDMK
CāŠ—;
;***** COPYIT
	TITLE COPYIT
	INTERNAL COPYIT,UPDN,STFCH
	EXTERNAL .COMM.,POSI,XRN,PTR
	EXTERNAL OUTLIM,RTLINE,LOOP
;;	DEFINE FLOAT(N)
;; <	TLC N,232000
;;	FADR N,N   >
	DEFINE FIXX(N)
<	JUMPGE	N,.+5
	MOVNS	N
	FIX 	N,233000    
	MOVNS	N
	CAIA
	FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.

;	SUBROUTINE COPYIT
;	COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
;	COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
;	1/PTR/PWDS(250),ITEM,LL,I,IX
;	EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R7,RJQ(5))
;	1,(R6,RJQ(4)),(N,RN(2500))
STFCH:	0
	SETO 13,	;FLAG FOR STFCH ROUTINE
	JRST .+3

COPYIT:	0
	SETZ 13,	;MAKE SURE IT'S 0
	SETZ 7,		;IM=ITEM
	MOVE 15,PTR+=252 	; AC7 IS K-1
	SOJ 15,		;(ITEM-1)
CP1:	JSA 16,RTLINE	;DO 1 K=1,IM
	JUMP PTR(7)	;L=PWDS(K)
	JUMPL CPY	;	IF(RTLINE(L))GO TO 1
	JSA 16,OUTLIM	;IF(OUTLIM(L,3))GO TO 1
	JUMP PTR(7)
	JUMP [3]
	JUMPL CPY
	MOVE 11,PTR(7)	; NOW L IS AC11
	MOVE 10,.COMM.+7 ;IF(R6.NE.0.AND.R6.NE.RN(L+1))GO TO 1
	JUMPE 10,CP3
	CAMN 10,XRN(11)
	JRST CPY
CP3:	JUMPL 13,STF2	; SKIP OVER FOR STFCH ROUTINE
	MOVE 12,XRN-1(11)
	FIXX(12)	;M=RN(L)+2
	ADDI 12,2
	JSA 16,LOOP	;CALL LOOP(0,M,1,I,L,RN)
	JUMP [0]
	JUMP 12
	JUMP [1]
	JUMP PTR+=252
	JUMP 11
	JUMP XRN
	AOS PTR+=250	;ITEM=ITEM+1
	MOVE 13,PTR+=250
	MOVE 11,PTR-1(13)	;L=PWDS(ITEM)
STF2:	MOVE 14,.COMM.+=8	;RN(L+2)=R7
	MOVEM 14,XRN+1(11)
	JUMPGE 13,CP2
	SKIPL POSI+=8
	JRST CPY
	MOVE 14,7
	AOJ 14,
	MOVEM 14,POSI+=8
	JRST CPY
CP2:	SKIPGE POSI+=8	;IF(JJ2)JJ2=ITEM
	MOVEM 13,POSI+=8
	AOJ 12,	;I=I+M+1
	ADDM 12,PTR+=252
	MOVEM 12,PTR(13)	;PWDS(ITEM+1)=I
CPY:	AOJ 7,		;1 CONTINUE
	CAMGE 7,15
	JRST CP1
	MOVE 7,.COMM.+=8	;R2=R7
	MOVEM 7,.COMM.		;DOES THIS MATTER FOR STFCH}
	JRA 16,(16)	;END

	;SUBROUTINE STFCH
	;INTEGER PWDS
	;COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
	;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	;1/PTR/PWDS(250),ITEM,LL,I,IX
	;EQUIVALENCE (R7,RJQ(5)),(R6,RJQ(4))
	;DO 1 K=1,ITEM
	;L=PWDS(K)
	;IF(RTLINE(L))GO TO 1
	;IF(OUTLIM(L,3))GO TO 1
	;IF(RN(L+1).NE.R6.AND.R6.NE.0)GO TO 1
;C DIDN'T MATCH THE CODE NUM.
	;IF(JJ2)JJ2=K
	;RN(L+2)=R7
;1	CONTINUE
	;END

UPDN: 	0	;SUBROUTINE UPDN(NST)
	;INTEGER PWDS
	;COMMON/XRN/RN(4000)  /KJY/ DONT,JY /POSI/S(8),JJ2,P
	;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
	;1/PTR/PWDS(250),ITEM,LL,I,IX
        MOVE 7,@(16)	;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
    	SOJ 7,		;1,(R6,RJQ(4))
UPDN0:	JSA 16,RTLINE	;DO 1 K=NST,ITEM
	JUMP PTR(7)	;L=PWDS(K)
	JUMPL UPDN1	;	IF(RTLINE(L))GO TO 1
	MOVE 11,PTR(7)	;RY=RN(L+1) -- 11 IS L
	MOVE 12,XRN(11)	;IF(RY.GT.16)GO TO 1
	CAMG 12,[16.0]	; AC12=RY
	CAMN 12,[8.0]		;IF(RY.EQ.8)GO TO 1
	JRST UPDN1
	CAMN 12,[3.0]		;IF(RY.EQ.3)GO TO 1
	JRST UPDN1
	CAMN 12,.COMM.+7	;IF(RY.EQ.R6)GO TO 10
	JRST UPDN10
	SKIPE .COMM.+7		;IF(R6.NE.0)GO TO 1
	JRST UPDN1
UPDN10:	CAME 12,[4.0]	; DIDN'T MATCH THE CODE NUM.
	JRST UPDN11	;10	;IF(RY.NE.4)GO TO 11
	MOVE 2,XRN-1(11)	;IF(RN(L).LT.3)GO TO 1
	CAMGE 2,[3.0]
	JRST UPDN1	; A BAR LINE
UPDN11:	JSA 16,OUTLIM	;11	IF(OUTLIM(L,3))GO TO 2
	JUMP PTR(7)
	JUMP [3]
	JUMPL UPDN2
	MOVE 2,.COMM.+=12	;RN(L+4)=RN(L+4)+R11
	FADRM 2,XRN+3(11)
	SKIPL POSI+=8		;IF(JJ2)JJ2=K
	JRST UPDN2
	MOVE 2,7
	AOJ 2,
	MOVEM 2,POSI+=8
UPDN2:	CAML 12,[4.0]	;2	;IF(RY.LT.4)GO TO 1
	CAML 12,[7.0]	;IF(RY.GE.7)GO TO 1
	JRST UPDN1	; NO WIGGLE ON TRILL
	CAME 12,[4.0]	;IF(RY.NE.4.)GO TO 12
	JRST UPDN12
	MOVE 15,XRN+4(11)	;IF(RN(L+5).EQ.50)GO TO 1
	CAMN 15,[50.0]		; 15 IS RN(L+5)
	JRST UPDN1	; CRESC. OR BOX
UPDN12:	JSA 16,OUTLIM	;12	;IF(OUTLIM(L,6))GO TO 1
	JUMP PTR(7)
	JUMP [6]
	JUMPL UPDN1
	MOVE 3,.COMM.+=12	;RN(L+5)=RN(L+5)+R11
	FADRM 3,XRN+4(11)
	SKIPL POSI+=8		;IF(JJ2)JJ2=K
	JRST UPDN1
	MOVE 2,7
	AOJ 2,
	MOVEM 2,POSI+=8
UPDN1:	AOJ 7,		;1	;CONTINUE
	CAMGE 7,PTR+=250
	JRST UPDN0
	JRA 16,@1(16)	;END
	END